﻿<%
'''依赖层级:001
'''依赖文件:functions.asp, AshapoConfig.class.asp, AshapoPreg.class.asp, AshapoString.class.php
'''底层文件类
'''核心FSO错误需直接抛出
Class AshapoFso

	'内部使用Fso名称
	Private s_fso
	
	'内部使用AshapoConfig对象
	Private s_cfg
	
	'内部使用AhsapoPreg对象
	Private s_reg
	
	'''构造
	Private Sub Class_Initialize()
		Set s_cfg = New AshapoConfig
		Set s_fso = Server.CreateObject(s_cfg.Environment("Scripting.FileSystemObject"))
		Set s_reg = New AshapoPreg
	End Sub
	
	'''析构
	Private Sub Class_Terminate()
		Set s_reg = Nothing
		Set s_fso = Nothing
		Set s_cfg = Nothing
	End Sub
	
	'''获取实际路径MapPath,不支持通配符
	'p_p:路径
	Public Function AbsPath(Byval p_p)
		On Error Resume Next
		If CStr(p_p) = "" Then
			AbsPath = ""
			Exit Function
		End If
		If Mid(p_p,2,1)<>":" Then
			p_p = Server.MapPath(p_p)
		End If
		If Right(p_p,1) = "\" Then
			p_p = Left(p_p,Len(p_p)-1)
		End If
		AbsPath = p_p
		If Err.Number<>0 Then
			Die("CORE ERROR 001:""" & p_p & """ is not a valid path")
		End If
	End Function
	
	'''获取能用于include的文件实际路径
	'p_path:路径
	Public Function AbsPathForWeb(Byval p_path)
		Dim t_string : Set t_string = New AshapoString
		AbsPathForWeb = "/" & t_string.CRight( AbsPath(p_path), Request.ServerVariables("APPL_PHYSICAL_PATH") )
		AbsPathForWeb = Replace(AbsPathForWeb, "\", "/")
		Set t_string = Nothing
	End Function

	'''判断文件是否存在
	'p_p:文件路径
	Public Function IsFile(Byval p_p)
		p_p = AbsPath(p_p)
		IsFile = False
		If s_fso.FileExists(p_p) Then
			IsFile = True
		End If
	End Function
	
	'''判断服务器上的文件夹是否存在
	'p_p:文件夹路径
	Public Function IsFolder(Byval p_p)
		p_p = AbsPath(p_p)
		IsFolder = False
		If s_fso.FolderExists(p_p) Then
			IsFolder = True
		End If
	End Function
	
	'''读取服务器端文件内容，仅支持UTF-8编码
	'p_p:文件路径
	Public Function ReadFile(Byval p_p)
		Dim t_s, t_t
		p_p = AbsPath(p_p)
		If IsFile(p_p) Then
			Set t_s = Server.CreateObject(s_cfg.Environment("Adodb.Stream"))
			With t_s
				.Type = 2
				.Mode = 3
				.Open
				.LoadFromFile p_p
				.Charset = "UTF-8"
				.Position = 2
				t_t = .ReadText
				.Close
			End With
			Set t_s = Nothing
			If s_reg.Test(t_t,"^\uFEFF") Then
				t_t = s_reg.Replace(t_t,"^\uFEFF","")
			End If
			ReadFile = t_t
		Else
			'抛出错误
			Die("CORE ERROR 002:the file """ & p_p & """ could not be read")
		End If
	End Function
	
	'''在服务器上创建文件夹,如果文件夹已存在则不需创建,支持多层目录创建
	'''如果创建失败，将显示底层错误
	'p_p:文件夹路径
	Public Sub CreateFolder(Byval p_p)
		On Error Resume Next
		Dim t_p, t_ap, t_i
		p_p = AbsPath(p_p)
		t_ap = Split(p_p,"\") : t_p = ""
		For t_i = 0 To Ubound(t_ap)
			t_p = t_p & t_ap(t_i) & "\"
			If Instr(t_p, AbsPath("/") & "\")>0 Then
				If Not IsFolder(t_p) And t_i>0 Then
					s_fso.CreateFolder(t_p)
				End If
			End If
		Next
		If Err.Number<>0 Then
			Die("CORE ERROR 003:unable to create folder """ & p_p & """")
		End If
	End Sub
	
	'''在服务器端创建文件并写入内容
	'p_p:文件路径
	'p_c:写入内容
	'p_b:写入BOM头
	Public Sub CreateFile(Byval p_p, Byval p_c, Byval p_b)
		'On Error Resume Next
		p_p = AbsPath(p_p)
		CreateFolder(Left(p_p,InstrRev(p_p,"\")-1))
		Dim t_sm : Set t_sm = Server.CreateObject(s_cfg.Environment("Adodb.Stream"))
		If p_b=1 Or p_b=True Then
			With t_sm
				.Type = 2
				.Open
				.Charset = "UTF-8"
				.Position = t_sm.Size
				.WriteText = p_c
				.SaveToFile p_p, 2
				.Close
			End With
		Else
			With t_sm
				.Type = 2
				.Mode = 3
				.Charset = "UTF-8"
				.Open
				.Writetext(p_c)
				.Position = 3
			End With
			Dim t_ns : Set t_ns = Server.CreateObject(s_cfg.Environment("Adodb.Stream"))
			With t_ns   
				.Mode = 3   
				.Type = 1   
				.Open()   
			End With
			t_sm.CopyTo(t_ns)
			t_ns.SaveToFile p_p, 2
			t_sm.Flush
			t_sm.Close
			t_ns.Close()
			Set t_ns = Nothing
		End If
		Set t_sm = Nothing
		If Err.Number<>0 Then
			Die("CORE ERROR 004:unable to create file """ & p_p & """")
		End If
	End Sub
	
	'''追加文件的内容(目前仅用于Log调用)
	'p_p:路径
	'p_c:文件追加内容字符串
	Public Sub AppendFile(Byval p_p, Byval p_c)
		p_p = AbsPath(p_p)
		Call CreateFile(p_p, ReadFile(p_p) & p_c, True)
	End Sub
	
	'''列出服务器上指定目录下所有的文件或文件夹
	'p_p:目录路径
	'p_t:指定类型(文件或文件夹或全部)
	Public Function [List](Byval p_p, Byval p_t)
		'On Error Resume Next
		Dim t_f, t_fs, t_k, t_a(), t_i, t_l
		p_p = AbsPath(p_p)
		t_i = 0
		Select Case LCase(p_t)
		Case "1","file"
			t_l = 1
		Case "2","folder"
			t_l = 2
		Case Else
			t_l = 0
		End Select
		Set t_f = s_fso.GetFolder(p_p)
		If t_l = 0 Or t_l = 2 Then
			Set t_fs = t_f.SubFolders
			ReDim Preserve t_a(t_fs.Count + t_i - 1)
			For Each t_k In t_fs
				Set t_a(t_i) = Server.CreateObject( s_cfg.Environment("Scripting.Dictionary") )
				t_a(t_i)("Name") = t_k.Name
				t_a(t_i)("DateLastModified") = t_k.DateLastModified
				t_a(t_i)("Type") = t_k.Type
				t_i = t_i + 1
			Next
		End If
		If t_l = 0 Or t_l = 1 Then
			Set t_fs = t_f.Files
			ReDim Preserve t_a(t_fs.Count + t_i - 1)
			For Each t_k In t_fs
				Set t_a(t_i) = Server.CreateObject( s_cfg.Environment("Scripting.Dictionary") )
				t_a(t_i)("Name") = t_k.Name
				t_a(t_i)("DateLastModified") = t_k.DateLastModified
				t_a(t_i)("Type") = t_k.Type
				t_i = t_i + 1
			Next
		End If
		Set t_fs = Nothing
		Set t_f = Nothing
		[List] = t_a
		If Err.Number<>0 Then
			Die("CORE ERROR 005:unable to get """ & p_p & """ information")
		End If
		Err.Clear()
	End Function
	
	'''从路径或者完整文件名获取不含后缀的文件名
	'p_f文件名(可以包含路径)
	Public Function NameOfFile(Byval p_f)
		Dim t_re
		If IsN(p_f) Then
			NameOfFile = ""
			Exit Function
		End If
		p_f = Replace(p_f,"\", "/")
		If Right(p_f,1) = "/" Then
			t_re = Split(p_f, "/")
			NameOfFile = IIF(p_t=0, t_re(Ubound(t_re)-1),"")
			Exit Function
		ElseIf Instr(p_f,"/")>0 Then
			t_re = Split(p_f,"/")(Ubound(Split(p_f,"/")))
		Else
			t_re = p_f
		End If
		If Instr(t_re,".")>0 Then
			NameOfFile = Left(t_re,InstrRev(t_re,".")-1)
		Else
			NameOfFile = t_re
		End If
	End Function
	
	'''删除文件
	'p_path:要删除的文件路径
	Public Sub DeleteFile(Byval p_path)
		If Not IsFile(p_path) Then
			Exit Sub
		End If
		On Error Resume Next
		p_path = AbsPath(p_path)
		Call s_fso.DeleteFile(p_path, True)
		If Err.Number<>0 Then
			Die("CORE ERROR XXX:unable to delete file """ & p_path & """")
		End If
	End Sub
	
	'''获取指定文件的最后修改时间戳
	'p_path:指定文件路径
	Public Function GetFileDateLastModified(Byval p_path)
		On Error Resume Next
		p_path = AbsPath(p_path)
		Dim t_f
		Set t_f = s_fso.GetFile(p_path)
		If Err.Number<>0 Then
			Die("CORE ERROR XXX:unable to Get File DateLastModified """ & p_path & """")
		End If
		GetFileDateLastModified = ToUnixTime(t_f.DateLastModified, "+8")
		Set t_f = Nothing
	End Function
End Class
%>